perm filename FOR01.DAT[NEW,LCS] blob
sn#165251 filedate 1975-06-21 generic text, type T, neo UTF8
00100 60 J2=R2
00200 RSTJ2=RSTFAC(J2)
00300 CL RD=0
00400 IF(JA.NE.2)GO TO 163
00500 IF(R9.EQ.0)GO TO 163
00600 K=ITEM
00700 C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
00800 IF(X22.NE.0)K=X22-1
00805 RD=1.75*RSTJ2
00810 L=PWDS(K+2)
00815 IF(RN(L+1).NE.4)GO TO 164
00817 C GO ON IF NEXT ISN'T BAR LINE (CODE 4. COULD FIND OTHER LINES!!)
00820 RB=RN(L+3)
00830 L=PWDS(K)
00840 C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
00860 IF(RN(L+1).NE.4)GO TO 164
00960 RA=RN(L+3)
01200 R3=RA+(RB-RA)/2-1.75*RSTJ2
01300 164 IF(PLT.EQ.0)GO TO 160
01400 RN(IFIX(PWDS(K+1))+3)=R3
01500 C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
01600 GO TO 5541
01700
01800 163 IF(JA.EQ.16)GO TO 63
01900 IF(PLT.NE.0)GO TO 5541
02000 IF(JA.NE.8)GO TO 70
02100 IF(R9.NE.1)GO TO 70
02200 R9=RN(MEDIT+9)
02300 IF(R9.NE.' ')TYPE 427,R9
02400 TYPE 21
02500 ACCEPT FA5,R9
02600 IF(R9.EQ.LY(1))R9=0
02700 C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
02800 70 IF(JA.NE.11)GO TO 160
02900 C ↑↑↑↑ WAS - TO 63
03000 IF(J10.NE.1)GO TO 62
03100 TYPE 21
03200 ACCEPT FA5,NJR
03300 C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
03400 LASTNM=NJR
03500 62 IF(NJR.EQ.0)NJR=LASTNM
03600 C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
03700 GO TO 160
03800 CC63 IF(JA.EQ.50)JA=16
03900 C ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
04000 CL63 IF(R3.LT.1000)GO TO 66
04100 CL RD=R3
04200 CL IF(JA.EQ.5)R13=R3/1000.
04300 CL CALL RNOTE(R3)
04400 C IF R3>1000 IT FINDS TRUE R3 THROUGH NOTE NUMB.
04500 CL66 IF(JA.NE.16)GO TO 160
04600 CX63 IF(JA.NE.16)GO TO 160
04700 C USE P10≠0 TO LINK UP TEXT.
04800 CCZZZZZZ IF(J10.EQ.0.OR.PLT.NE.0)GO TO 160
04900 63 IF(J10.EQ.0)GO TO 162
05000 CX R10=0
05100 L=ITEM
05200 IF(X22.NE.0)L=X22-1
05300 IF(J10.EQ.1)GO TO 263
05400 C NEXT FOR CENTERING OF TEXT. P10>1
05500 RB=0
05600 X=PWDS(L+1)
05700 363 L=L+1
05800 K=PWDS(L)
05900 RB=RB+RN(K+9)
06000 C ADD SPACE NEEDED
06100 K=PWDS(L+1)
06200 IF(RN(K+1).NE.16)GO TO 463
06300 IF(RN(K).EQ.8)GO TO 363
06400 C GO BACK IF MORE LETTERS TO COME
06500 463 R3=R10-(RB-3.4)*R5*RSTJ2/2.
06600 C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
06700 R10=0
06800 IF(RN(X).EQ.8)RN(X+10)=0
06900 RN(X+3)=R3
07000 C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
07100 GO TO 162
07200 263 K=PWDS(L)
07300 R3=R5*RSTJ2*RN(K+9)+RN(K+3)
07400 RN(IFIX(PWDS(L+1))+3)=R3
07500 C PUTS POS. BACK INTO RN ARRAY EVERY TIME.
07600 C PUTS 13TH(+) LETTER IN RIGHT POS.
07700 162 IF(PLT.NE.0)GO TO 5541
07800 CX160 IF(EDX.NE.0)GO TO 162
07900 CP IF(I1.EQ.IP)GO TO 5541
08000 CX162 RJ3=R3
08100 160 RJ3=R3
08200 JJA=JA
08300 IF(R8.NE.0)GO TO 161
08400 IF(JA.EQ.1)R8=999.
08500 C 999=0 FOR STEM EXTENSIONS.
08600 CL161 CNT=1
08700 CL DO 5543 K=1,9
08800 C 10/6/73 ABOVE WAS ,11
08900 CL RA=RJQ(K)
09000 CL IF(RA.NE.0)CNT=K
09100 CL5543 RJJ(K)=RA
09200 C USES ONLY 10 PARAMETERS BEYOND JA, J2
09300 161 CALL MSSLUP
09400 CP2554 IF(PLT.NE.0)GO TO 5541
09500 IF(JA.EQ.6)CALL HOMER
09600 IF(JA.NE.13)GO TO 1261
09700 IF(J6.NE.0)R13=-1
09800
09900 1261 IF(R13.EQ.0)GO TO 261
10000 CALL HOMER
10100 IF(JA.EQ.10)R3=R3+RSTJ2
10200 C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
10300 C IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
10400 C **** FOR '0' EDITS ******
10500 CL261 RN(I)=CNT
10600 CL RN(I+1)=JA
10700 CL I=I+2
10800 CL RN(I)=R2
10900 CL IF(RD.NE.0)RN(I)=RD
11000 C TO SAVE NOTE NUMBS IN P2.
11100 CL DO 4554 K=1,CNT
11200 CL4554 RN(I+K)=RJQ(K)
11300 CL3554 I=CNT+1+I
11400 261 CALL LUP2